The Coronavirus Dashboard: the case of Belgium
This Coronavirus dashboard: the case of Belgium provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Belgium. This dashboard is built with R using the R Makrdown framework and was adapted from this dashboard by Rami Krispin.
Code
The code behind this dashboard is available on GitHub.
Contact
For any question or feedback, you can contact me. More information about this dashboard can be found in this article.
Update
The data is as of Sunday March 22, 2020 and the dashboard has been updated on Tuesday March 24, 2020.
---
title: "Coronavirus in Sri Lanka"
author: "Thiyanga Talagala"
output:
flexdashboard::flex_dashboard:
orientation: rows
# social: ["facebook", "twitter", "linkedin"]
source_code: embed
vertical_layout: fill
---
```{r setup, include=FALSE}
#------------------ Packages ------------------
library(flexdashboard)
# install.packages("devtools")
# devtools::install_github("RamiKrispin/coronavirus")
library(coronavirus)
data(coronavirus)
# update_datasets()
# View(coronavirus)
`%>%` <- magrittr::`%>%`
#------------------ Parameters ------------------
# Set colors
# https://www.w3.org/TR/css-color-3/#svg-color
confirmed_color <- "purple"
active_color <- "#1f77b4"
recovered_color <- "forestgreen"
death_color <- "red"
#------------------ Data ------------------
df <- coronavirus %>%
# dplyr::filter(date == max(date)) %>%
dplyr::filter(Country.Region == "Sri Lanka") %>%
dplyr::group_by(Country.Region, type) %>%
dplyr::summarise(total = sum(cases)) %>%
tidyr::pivot_wider(
names_from = type,
values_from = total
) %>%
dplyr::mutate(unrecovered = confirmed - ifelse(is.na(recovered), 0, recovered) - ifelse(is.na(death), 0, death)) %>%
dplyr::arrange(-confirmed) %>%
dplyr::ungroup() %>%
dplyr::mutate(country = dplyr::if_else(Country.Region == "United Arab Emirates", "UAE", Country.Region)) %>%
dplyr::mutate(country = dplyr::if_else(country == "Mainland China", "China", country)) %>%
dplyr::mutate(country = dplyr::if_else(country == "North Macedonia", "N.Macedonia", country)) %>%
dplyr::mutate(country = trimws(country)) %>%
dplyr::mutate(country = factor(country, levels = country))
df_daily <- coronavirus %>%
dplyr::filter(Country.Region == "Sri Lanka") %>%
dplyr::group_by(date, type) %>%
dplyr::summarise(total = sum(cases, na.rm = TRUE)) %>%
tidyr::pivot_wider(
names_from = type,
values_from = total
) %>%
dplyr::arrange(date) %>%
dplyr::ungroup() %>%
dplyr::mutate(active = confirmed - death - recovered) %>%
dplyr::mutate(
confirmed_cum = cumsum(confirmed),
death_cum = cumsum(death),
recovered_cum = cumsum(recovered),
active_cum = cumsum(active)
)
df1 <- coronavirus %>% dplyr::filter(date == max(date))
```
Summary
=======================================================================
Row {data-width=400}
-----------------------------------------------------------------------
### confirmed {.value-box}
```{r}
valueBox(
value = paste(format(sum(df$confirmed), big.mark = ","), "", sep = " "),
caption = "Total confirmed cases",
icon = "fas fa-user-md",
color = confirmed_color
)
```
### active {.value-box}
```{r}
valueBox(
value = paste(format(sum(df$unrecovered, na.rm = TRUE), big.mark = ","), " (",
round(100 * sum(df$unrecovered, na.rm = TRUE) / sum(df$confirmed), 1),
"%)",
sep = ""
),
caption = "Active cases (% of total cases)", icon = "fas fa-ambulance",
color = active_color
)
```
### death {.value-box}
```{r}
valueBox(
value = paste(format(sum(df$death, na.rm = TRUE), big.mark = ","), " (",
round(100 * sum(df$death, na.rm = TRUE) / sum(df$confirmed), 1),
"%)",
sep = ""
),
caption = "Death cases (death rate)",
icon = "fas fa-heart-broken",
color = death_color
)
```
Row
-----------------------------------------------------------------------
### **Daily cumulative cases by type** (Belgium only)
```{r}
plotly::plot_ly(data = df_daily) %>%
plotly::add_trace(
x = ~date,
y = ~active_cum,
type = "scatter",
mode = "lines+markers",
name = "Active",
line = list(color = active_color),
marker = list(color = active_color)
) %>%
plotly::add_trace(
x = ~date,
y = ~death_cum,
type = "scatter",
mode = "lines+markers",
name = "Death",
line = list(color = death_color),
marker = list(color = death_color)
) %>%
plotly::add_annotations(
x = as.Date("2020-02-04"),
y = 1,
text = paste("First case"),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -10,
ay = -90
) %>%
plotly::add_annotations(
x = as.Date("2020-03-11"),
y = 3,
text = paste("First death"),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -90,
ay = -90
) %>%
plotly::add_annotations(
x = as.Date("2020-03-18"),
y = 14,
text = paste(
"New containment",
"",
"measures"
),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -10,
ay = -90
) %>%
plotly::layout(
title = "",
yaxis = list(title = "Cumulative number of cases"),
xaxis = list(title = "Date"),
legend = list(x = 0.1, y = 0.9),
hovermode = "compare"
)
```
Comparison
=======================================================================
Column {data-width=400}
-------------------------------------
### **Daily new cases**
```{r}
daily_confirmed <- coronavirus %>%
dplyr::filter(type == "confirmed") %>%
dplyr::filter(date >= "2020-03-11") %>%
dplyr::mutate(country = Country.Region) %>%
dplyr::group_by(date, country) %>%
dplyr::summarise(total = sum(cases)) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = country, values_from = total)
#----------------------------------------
# Plotting the data
daily_confirmed %>%
plotly::plot_ly() %>%
plotly::add_trace(
x = ~date,
y = ~ "Sri Lanka",
type = "scatter",
mode = "lines+markers",
name = "Sri Lanka"
) %>%
plotly::add_trace(
x = ~date,
y = ~France,
type = "scatter",
mode = "lines+markers",
name = "France"
) %>%
plotly::add_trace(
x = ~date,
y = ~Spain,
type = "scatter",
mode = "lines+markers",
name = "Spain"
) %>%
plotly::add_trace(
x = ~date,
y = ~Italy,
type = "scatter",
mode = "lines+markers",
name = "Italy"
) %>%
plotly::layout(
title = "",
legend = list(x = 0.1, y = 0.9),
yaxis = list(title = "Number of new cases"),
xaxis = list(title = "Date"),
# paper_bgcolor = "black",
# plot_bgcolor = "black",
# font = list(color = 'white'),
hovermode = "compare",
margin = list(
# l = 60,
# r = 40,
b = 10,
t = 10,
pad = 2
)
)
```
### **Cases distribution by type**
```{r daily_summary}
df_EU <- coronavirus %>%
# dplyr::filter(date == max(date)) %>%
dplyr::filter(Country.Region == "Sri Lanka" |
Country.Region == "France" |
Country.Region == "Italy" |
Country.Region == "Spain") %>%
dplyr::group_by(Country.Region, type) %>%
dplyr::summarise(total = sum(cases)) %>%
tidyr::pivot_wider(
names_from = type,
values_from = total
) %>%
dplyr::mutate(unrecovered = confirmed - ifelse(is.na(recovered), 0, recovered) - ifelse(is.na(death), 0, death)) %>%
dplyr::arrange(confirmed) %>%
dplyr::ungroup() %>%
dplyr::mutate(country = dplyr::if_else(Country.Region == "United Arab Emirates", "UAE", Country.Region)) %>%
dplyr::mutate(country = dplyr::if_else(country == "Mainland China", "China", country)) %>%
dplyr::mutate(country = dplyr::if_else(country == "North Macedonia", "N.Macedonia", country)) %>%
dplyr::mutate(country = trimws(country)) %>%
dplyr::mutate(country = factor(country, levels = country))
plotly::plot_ly(
data = df_EU,
x = ~country,
y = ~unrecovered,
# text = ~ confirmed,
# textposition = 'auto',
type = "bar",
name = "Active",
marker = list(color = active_color)
) %>%
plotly::add_trace(
y = ~death,
# text = ~ death,
# textposition = 'auto',
name = "Death",
marker = list(color = death_color)
) %>%
plotly::layout(
barmode = "stack",
yaxis = list(title = "Total cases"),
xaxis = list(title = ""),
hovermode = "compare",
margin = list(
# l = 60,
# r = 40,
b = 10,
t = 10,
pad = 2
)
)
```
Map
=======================================================================
### **World map of cases** (*use + and - icons to zoom in/out*)
```{r}
# map tab added by Art Steinmetz
library(leaflet)
library(leafpop)
library(purrr)
cv_data_for_plot <- coronavirus %>%
# dplyr::filter(Country.Region == "Belgium") %>%
dplyr::filter(cases > 0) %>%
dplyr::group_by(Country.Region, Province.State, Lat, Long, type) %>%
dplyr::summarise(cases = sum(cases)) %>%
dplyr::mutate(log_cases = 2 * log(cases)) %>%
dplyr::ungroup()
cv_data_for_plot.split <- cv_data_for_plot %>% split(cv_data_for_plot$type)
pal <- colorFactor(c("orange", "red", "green"), domain = c("confirmed", "death", "recovered"))
map_object <- leaflet() %>% addProviderTiles(providers$Stamen.Toner)
names(cv_data_for_plot.split) %>%
purrr::walk(function(df) {
map_object <<- map_object %>%
addCircleMarkers(
data = cv_data_for_plot.split[[df]],
lng = ~Long, lat = ~Lat,
# label=~as.character(cases),
color = ~ pal(type),
stroke = FALSE,
fillOpacity = 0.8,
radius = ~log_cases,
popup = leafpop::popupTable(cv_data_for_plot.split[[df]],
feature.id = FALSE,
row.numbers = FALSE,
zcol = c("type", "cases", "Country.Region", "Province.State")
),
group = df,
# clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = F),
labelOptions = labelOptions(
noHide = F,
direction = "auto"
)
)
})
map_object %>%
addLayersControl(
overlayGroups = names(cv_data_for_plot.split),
options = layersControlOptions(collapsed = FALSE)
)
```
About
=======================================================================
**The Coronavirus Dashboard: the case of Belgium**
This Coronavirus dashboard: the case of Belgium provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic for Belgium. This dashboard is built with R using the R Makrdown framework and was adapted from this [dashboard](https://ramikrispin.github.io/coronavirus_dashboard/){target="_blank"} by Rami Krispin.
**Code**
The code behind this dashboard is available on [GitHub](https://github.com/thiyangt/CoronaSriLanka){target="_blank"}.
**Contact**
For any question or feedback, you can [contact me](https://thiyanga.netlify.com/). More information about this dashboard can be found in this [article](https://www.statsandr.com/blog/how-to-create-a-simple-coronavirus-dashboard-specific-to-your-country-in-r/).
**Update**
The data is as of `r format(max(coronavirus$date), "%A %B %d, %Y")` and the dashboard has been updated on `r format(Sys.time(), "%A %B %d, %Y")`.